home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / techjock.arc / READTTT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-11-18  |  6KB  |  182 lines
  1. {$S-,R-,V-,D-,T-}
  2. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  3. {         TechnoJocks Turbo Toolkit v4.00            Released: Feb 1, 1988    }
  4. {                                                                             }
  5. {         Module: ReadTTT  --  single line input proc with full editing       }
  6. {                                                                             }
  7. {                       Copyright R. D. Ainsbury (c) 1986                     }
  8. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  9.  
  10.  
  11. Unit ReadTTT;
  12.  
  13. Interface
  14.  
  15. Uses CRT,FastTTT;
  16.  
  17. Procedure ReadLine(X,Y,L,F,B:byte;
  18.                      var Text   :string;
  19.                      var Retcode:integer);
  20.  
  21.  
  22. Implementation
  23.  
  24. Procedure ReadLine(X,Y,L,F,B:byte;
  25.                      var Text   :string;
  26.                      var Retcode:integer);
  27. Const
  28.     CursorRight = #205;
  29.     CursorLeft  = #203;
  30.     EnterKey    = #13;
  31.     EscKey      = #27;
  32.     EndKey      = #207;
  33.     HomeKey     = #199;
  34.     DelKey      = #211;
  35.     Backspace   = #8;
  36.     InsKey      = #210;
  37.  
  38. var
  39.     TempText : string;
  40.     CursorPos : byte;
  41.     InsertMode,
  42.     Alldone : boolean;
  43.     Ch : char;
  44.  
  45.     Procedure Check_Parameters;
  46.     begin
  47.         TempText := Text;
  48.         If length(TempText) > L then
  49.            Delete(Temptext,L+1,length(TempText)-L);
  50.         If not X in [1..80] then
  51.            X := 1;
  52.         If X + L - 1 > 80 then X := 81 - L;
  53.         If not Y in [1..25] then
  54.            Y := 1;
  55.         If length(TempText) < L then
  56.            CursorPos := length(TempText) + 1
  57.         else
  58.            CursorPos := length(TempText);
  59.         Retcode := 0;
  60.         InsertMode  := False;
  61.         Alldone := False;
  62.     end;  {sub Proc Check_Parameters}
  63.  
  64.     Function Underline(Str:string):string;
  65.     var I : integer;
  66.     begin
  67.         while length(Str) < L do
  68.               Str := Str + '_';
  69.         Underline := Str;
  70.     end; {sub Func Underline}
  71.  
  72.     Procedure MoveTheCursor;
  73.     begin
  74.         GotoXY(X+CursorPos-1,Y);
  75.     end;  {sub Proc MoveTheCursor}
  76.  
  77.     Procedure Write_String;
  78.     begin
  79.         Fastwrite(X,Y,attr(F,B),Underline(TempText));
  80.         MoveTheCursor;
  81.     end;
  82.  
  83.     Procedure Erase_Field;
  84.     begin
  85.         TempText := '';
  86.         CursorPos := 1;
  87.         Write_String;
  88.     end;
  89.  
  90.     Procedure Char_Backspace;
  91.     begin
  92.         If CursorPos > 1 then
  93.         begin
  94.             CursorPos := Pred(CursorPos);
  95.             Delete(TempText,CursorPos,1);
  96.             Write_String;
  97.        end;
  98.     end;   {sub Proc Char_Backspace}
  99.  
  100.     Procedure Char_Del;
  101.     begin
  102.         If CursorPos <= length(TempText) then
  103.         begin
  104.             Delete(TempText,CursorPos,1);
  105.             Write_String;
  106.         end;
  107.     end;   {sub Proc Char_Del}
  108.  
  109.  
  110. begin                  {main Procedure IO1Line}
  111.     Check_Parameters;
  112.     Write_String;
  113.     Repeat
  114.          Ch:= Readkey;
  115.          If (Ch = EscKey) and keypressed then
  116.          begin
  117.              Ch := readkey;
  118.              Ch := chr(ord(Ch) + 128);
  119.          end;
  120.          Case upcase(Ch) of
  121.          CursorRight   :  begin
  122.                               If (CursorPos < L)
  123.                               and (CursorPos <= length(TempText)) then
  124.                               begin
  125.                                   CursorPos := Succ(CursorPos);
  126.                                   MoveTheCursor;
  127.                               end;
  128.                           end;
  129.          CursorLeft    :  begin
  130.                               If CursorPos > 1 then
  131.                               begin
  132.                                   CursorPos := Pred(CursorPos);
  133.                                   MoveTheCursor;
  134.                               end;
  135.                           end;
  136.          HomeKey       :  begin
  137.                               CursorPos := 1;
  138.                               MoveTheCursor;
  139.                           end;
  140.          EndKey        :  begin
  141.                               If CursorPos < L then
  142.                               If length(TempText) < L then
  143.                                   CursorPos := length(TempText) + 1
  144.                               else
  145.                                   CursorPos := L;
  146.                               MoveTheCursor;
  147.                           end;
  148.         InsKey        :  InsertMode := not InsertMode;
  149.         DelKey        :  Char_Del;
  150.         BackSpace     :  Char_Backspace;
  151.         EscKey        :  begin
  152.                              Alldone := true;
  153.                              Retcode := 1;
  154.                          end;
  155.         EnterKey      :  begin
  156.                              Alldone := true;
  157.                              Text := TempText;
  158.                          end;
  159.        #32 .. #126    :  begin
  160.                              If InsertMode then
  161.                              begin
  162.                                  If length(TempText) < L then
  163.                                  begin
  164.                                      Insert(Ch,TempText,CursorPos);
  165.                                      If CursorPos < L then
  166.                                         CursorPos := Succ(CursorPos);
  167.                                  end;
  168.                              end
  169.                              else {not insertmode}
  170.                              begin
  171.                                  Delete(TempText,CursorPos,1);
  172.                                  Insert(Ch,TempText,CursorPos);
  173.                                  If CursorPos < L then
  174.                                     CursorPos := Succ(CursorPos);
  175.                              end;   {if insert}
  176.                              Write_String;
  177.                           end;
  178.       end; {case}
  179.       Until Alldone;
  180. end;  {Proc Read_Line}
  181.  
  182. end.